Program DumpPICT;
{ Very basic sample on how to dump a picture to a PICT file.
}
{ to make it more general substitute the stuff between the Open/Close Picture calls
  with whatever suits your fancy.
  
  Warning: No claims are made regarding the fitness of this program to any particular 
  purpose. Use it at your own risk!
}
USES Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf;

TYPE BitMapPtr = ^BitMap;

{ The following variables must be globals }
VAR 	pHand2: PicHandle;
  		globalRef: INTEGER;
		
Procedure PutPICTData(dataPtr: Ptr; byteCount: Integer);
{ This procedure can not be a nested procedure }

VAR longCount:LONGINT;

BEGIN
	longCount:= byteCount;
	IF FSWrite( globalRef, longCount, dataPtr) <> noErr THEN Debugger;
	IF pHand2 <> NIL THEN    { Help QD take care of oddness in the picture }
	  pHand2^^.picSize:=pHand2^^.picSize + longCount; 
END;

PROCEDURE PictOut;
VAR
  err: OSErr;
  i, vrefnum: INTEGER;
  where: Point;		        { where to display dialog }
  longCount,
  longZero: LONGINT;
  reply: SFReply;	        { reply record }
  myProcs: CQDProcs;
  
  myPort:GrafPort;
  myPortPtr,oldPort:GrafPtr;
  
  myRect,pictRect:Rect;
    
BEGIN
		 GetPort(oldPort);
		 myPortPtr:= @myPort; 	{ initialize }
		 OpenPort(myPortPtr);	{ set my port }
		 
		 where.h:= 20;
		 where.v:=20;
		 SFPutFile(where,'Save picture as: ','untitled',NIL,reply);IF NOT(reply.good) THEN Debugger;
		 err:= Create(reply.fName,reply.vrefnum,'????','PICT');IF err<>0 THEN Debugger;
		 err := FSOpen(reply.fName,vrefnum, globalRef); IF err<>0 THEN Debugger;
		 pHand2 := NIL;
	     
		 SetStdCProcs(myProcs);
		 myPortPtr^.grafProcs:=@myProcs;
		 myProcs.putPicProc:=@PutPictData;
		 
		 SetRect(myRect,100,100,300,300);
		 SetRect(pictRect,0,0,500,500);
		 
		 longZero := 0;
		 longCount := 4;
		 FOR i := 1 TO (512 + SizeOf(Picture)) DIV 4 DO
		   err := FSWrite (globalRef, longCount, @longZero);IF err<>0 THEN Debugger;
		 pHand2 := OpenPicture (pictRect);
		 
		 MoveTo(5,10);
		 DrawString('This is a picture saved to disk');
		 PaintRect(myRect);
		 
		 ClosePicture;
	   
		 IF SetFPos (globalRef, fsFromStart, 512) <> noErr THEN Debugger;
		 longCount := SizeOf(Picture); 
	     IF FSWrite (globalRef,longCount , Ptr(pHand2^)) <> noErr THEN Debugger;

	     IF FSClose (globalRef) <> noErr THEN Debugger;

 		 myPortPtr^.grafProcs:=NIL;
		 
	     KillPicture (pHand2);
		 SetPort(oldPort);
END; {OutPICT}

BEGIN
		InitGraf(@thePort);
		InitFonts;
		FlushEvents(everyEvent, 0);
		InitWindows;
		InitMenus;
		TEInit;
		InitDialogs(NIL);
		InitCursor;
		
		PictOut;
END.